home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0032_Pascal Environment.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  3KB  |  135 lines
  1. {
  2. From: RUUD UPHOFF                  Refer#: NONE
  3. Subj: TPENV.PAS                      Conf: (1221) F-PASCAL
  4. ---------------------------------------------------------------------------
  5. }
  6.  
  7. UNIT   SetEnvir;
  8.  
  9. INTERFACE
  10.  
  11.  
  12.    USES
  13.              DOS;
  14.  
  15.  
  16.    TYPE
  17.              EnvSize    = 0..16383;
  18.  
  19.  
  20.    PROCEDURE SetEnv( EnvVar,Value : STRING);
  21.  
  22.      {-----------------------------------------------------------------------
  23. { This procedure may be used to setup or change environment variables
  24. { in the environment of the resident copy of COMMAND.COM or 4DOS.COM
  25. {
  26. { Note that this will be the ACTIVE copy of the command interpreter, NOT
  27. { the primary copy!
  28. {
  29. { This unit is not tested under DR-DOS.
  30. {
  31. { Any call of SetEnv must be followed by checking ioresult. The procedure
  32. { may return error 8 (out of memory) on too less space in te environment.
  33. {-----------------------------------------------------------------------}
  34.  
  35.  
  36.  
  37.  
  38. IMPLEMENTATION
  39.  
  40.  
  41.  
  42.    PROCEDURE SetEnv( EnvVar, Value : STRING);
  43.  
  44.       VAR
  45.              Link,
  46.              PrevLink,
  47.              EnvirP   : word;
  48.  
  49.              Size,
  50.              Scan,
  51.              Where,
  52.              Dif      : integer;
  53.  
  54.              NewVar,
  55.              OldVar,
  56.              Test     : STRING;
  57.  
  58.  
  59.       FUNCTION  CheckSpace(Wanted : integer) : boolean;
  60.  
  61.       BEGIN
  62.          IF wanted+Scan > Size THEN
  63.             inoutres:=8;
  64.          CheckSpace := inoutres=0
  65.       END;
  66.  
  67.  
  68.    BEGIN
  69.       IF inoutres >0 THEN
  70.          Exit;
  71.       FOR Scan := 1 TO Length(EnvVar) DO
  72.          EnvVar[Scan] := UpCase(EnvVar[Scan]);
  73.       EnvVar := EnvVar + '=';
  74.       NewVar := EnvVar + Value + #0;
  75.       link := PrefixSeg;
  76.  
  77.       REPEAT
  78.          PrevLink := Link;
  79.          Link := memw [link : $16]
  80.       UNTIL Link = prevlink;
  81.  
  82.       EnvirP := memw [Link : $2C];
  83.       Size  := memw [Envirp-1 : $03] * 16;
  84.       Scan := 0;
  85.       Where := -1;
  86.       WHILE mem[EnvirP : Scan] <>0 DO
  87.  
  88.          BEGIN
  89.             move( mem[EnvirP : scan], Test[1], 255);
  90.             Test[0] := #255;
  91.             Test[0] := chr(pos(#0,Test));
  92.             IF pos(EnvVar, Test) =1 THEN
  93.  
  94.                BEGIN
  95.                   Where := Scan;
  96.                   OldVar := Test
  97.                END;
  98.  
  99.             Scan := Scan + Length(Test)
  100.          END;
  101.  
  102.       IF Where = -1 THEN
  103.  
  104.          BEGIN
  105.             Where := Scan;
  106.             NewVar := NewVar + #0#0#0;
  107.             IF NOT CheckSpace( Length(NewVar) ) THEN
  108.                Exit
  109.          END
  110.  
  111.       ELSE
  112.  
  113.          BEGIN
  114.             Dif := Length(NewVar) - Length(OldVar);
  115.             IF Dif >0 THEN
  116.  
  117.                BEGIN
  118.                   IF NOT CheckSpace(Dif) THEN
  119.                      Exit;
  120.                   move( mem[ EnvirP : Where ],
  121.                         mem[ EnvirP : Where + Dif ],
  122.                         Scan-Where+3)
  123.                END
  124.  
  125.             ELSE IF Dif <0 THEN
  126.                move( mem[ EnvirP : Where - Dif ],
  127.                      mem[ EnvirP : Where ],
  128.                      Size-Where+Dif)
  129.          END;
  130.  
  131.       move( NewVar[1], mem[EnvirP : Where], Length(NewVar) )
  132.    END;
  133.  
  134. END.
  135.